home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / fortran / mslang / vax2pc / vax2pc.for
Text File  |  1994-06-15  |  9KB  |  274 lines
  1. c
  2. c VAX2PC.FOR
  3. c
  4. c     Programmed by Mike Shefler
  5. c                   CONSAD Research Corporation
  6. c                   121 North Highland Avenue
  7. c                   Pittsburgh, PA 15206-3050
  8. c                   (412) 363-5500 (voice)
  9. c                   (412) 363-5509 (FAX)
  10. c                   CIS: 70027,36
  11. c
  12. c             Hereby placed in the public domain.
  13. c             Not responsible for any damages arising from the use
  14. c             of this program.
  15. c
  16. c     This program converts a VAX FORTRAN program to Microsoft format.
  17. c     The following conversions are performed:
  18. c         1. Lines are output in "standard line format", i.e. they start
  19. c            in column 7 and go out to column 72. Tabs are replaced with
  20. c            blanks. The parameter TAB_SIZE can be used to adjust the tabs.
  21. c         2. Parameter statements of the form "PARAMETER X=2" are converted
  22. c            to the form "PARAMETER (X=2)".
  23. c         3. The VAX-style INCLUDE directive is changed to PC-style.
  24. c         4. Statements of the form "TYPE *," are converted to "WRITE *,"
  25. c         5. The keywords "Readonly" and "Carriagecontrol=whatever" are
  26. c            removed from OPEN statements.
  27. c         6. Replaces the ",$)" string in FORMAT statements with the
  28. c            PC equivalent ",\)".
  29. c
  30. c     The input file is assumed to have an extension of .FVR and the
  31. c     output file will have an extension of .FOR. 
  32. c
  33.       PROGRAM VAX2PC
  34.       IMPLICIT NONE
  35.  
  36.       CHARACTER TAB_CHAR*(*)
  37.       PARAMETER (TAB_CHAR = '    ')
  38.       INTEGER TAB_SIZE
  39.       PARAMETER (TAB_SIZE = 4)
  40.  
  41.       CHARACTER FileName*8, Line*132, Out*132, c*1, InFile*12, OuFile*12
  42.       CHARACTER Temp*132
  43.       INTEGER n1, p, q, r, p1, p2, p3
  44.       LOGICAL InQuote, InComment, IsDigit, StillDigit, IsOnDisk, Acomma
  45. c----------------------------------------------------------------------------
  46. 99    WRITE (*,1)
  47. 1     FORMAT (' Enter the Filename to convert (no ext implies .FVR):'\)
  48.       READ (*,2) FileName
  49. 2     FORMAT (a)
  50.       IF (INDEX(FileName,'.') .LE. 0) THEN    ! Add extension of .FVR
  51.           InFile = FileName(:Len_Trim(FileName)) // '.FVR'
  52.           OuFile = FileName(:Len_Trim(FileName)) // '.FOR'
  53.       ELSE
  54.           InFile=FileName
  55.           p = INDEX(FileName,'.')
  56.           OuFile = FileName(:p) // '.FOR'
  57.       ENDIF
  58. c
  59. c Check for files' existence. If input doesn't, then re-ask. If
  60. c output does, confirm overwrite.
  61. c
  62.       INQUIRE (File=InFile, Exist=IsOnDisk)
  63.       IF (.NOT. IsOnDisk) THEN
  64.           WRITE (*,*) ' That file doesn''t exist, try again.'
  65.           GOTO 99
  66.       ENDIF
  67.       INQUIRE (File=OuFile, Exist=IsOnDisk)
  68.       IF (IsOnDisk) THEN
  69.           WRITE (*,3)
  70. 3     FORMAT (' That file already exists. OK to overwrite (Y/N)?'\)
  71.           READ (*,2) c
  72.           IF (c .NE. 'y' .AND. c .NE. 'Y') GOTO 99
  73.       ENDIF
  74.       OPEN (Unit=1, File=InFile, Status='OLD')
  75.       OPEN (Unit=2, File=OuFile, Status='UNKNOWN')
  76. c----------------------------------------------------------------------------
  77. c
  78. c Process each line individually. It may look messy on output if you
  79. c have continuation lines that are over 80 characters, but that's the
  80. c price you pay.
  81. c
  82. 100   READ (1,2,End=199) Line
  83.       n1 = n1 + 1
  84. c
  85. c Change VAX-style INCLUDE statements to MS-style
  86. c
  87.       IF (INDEX(Line,'INCLUDE ''') .GT. 0
  88.      1.OR. INDEX(Line,'Include ''') .GT. 0
  89.      2.OR. INDEX(Line,'include ''') .GT. 0) THEN
  90.           p = INDEX(Line,'''')
  91.           Out = '$INCLUDE: ' // Line(p:)
  92.           GOTO 150
  93.       ENDIF
  94. c
  95. c Change VAX-style PARAMETER statements (without parens) to MS-style
  96. c (with parens). Have to be careful not to include inline comments
  97. c inside the parens.
  98. c
  99.       p1 = INDEX(Line,'PARAMETER ')
  100.       p2 = INDEX(Line,'Parameter ')
  101.       p3 = INDEX(Line,'parameter ')
  102.       p = MAX(p1,p2,p3)
  103.       q = INDEX(Line,'!')         ! Look for inline comment
  104.       r = INDEX(Line,'(')         ! And see if paren already there
  105.       IF (p .GT. 0 .AND. p .LT. 10 .AND. (r .EQ. 0 .OR. r .GT. q)) THEN
  106.           p = p + 9
  107.           IF (q .LE. 0) THEN
  108.               Out = Line(:p) // '(' // Line(p+1:Len_Trim(Line)) // ')'
  109.           ELSE
  110.               Out = Line(:p) // '(' // Line(p+1:q-1) // ') ' // Line(q:)
  111.           ENDIF
  112.           Line = Out
  113.           GOTO 120
  114.       ENDIF
  115. c
  116. c Replace VAX-style TYPE *,whatever with the MS-style WRITE (*,*)whatever
  117. c
  118.       p1 = INDEX(Line,'TYPE *,')
  119.       p2 = INDEX(Line,'Type *,')
  120.       p3 = INDEX(Line,'type *,')
  121.       p = MAX(p1,p2,p3)
  122.       IF (p .GT. 0) THEN
  123.           Out = Line(:p-1) // 'WRITE (*,*)' // Line(p+7:)
  124.           Line = Out
  125.           GOTO 120
  126.       ENDIF
  127. c
  128. c Remove the READONLY and CARRIAGECONTROL parameters from OPEN statements.
  129. c
  130.       p1 = INDEX(Line,'READONLY')
  131.       p2 = INDEX(Line,'Readonly')
  132.       p3 = INDEX(Line,'readonly')
  133.       p = MAX(p1,p2,p3)
  134.       IF (p .GT. 0) THEN
  135.           q = p + 8
  136.           Acomma = .FALSE.
  137.           DO WHILE (p .GT. 0 .AND. .NOT. Acomma)
  138.               IF (Line(p:p) .EQ. ',') Acomma = .TRUE.
  139.               p = p - 1
  140.           ENDDO
  141.           IF (p .GT. 0) THEN
  142.               Temp = Line(:p) // Line(q:)
  143.               Line = Temp
  144.           ENDIF
  145.           GOTO 120
  146.       ENDIF
  147.  
  148.       p1 = INDEX(Line,'CARRIAGECONTROL=')
  149.       p2 = INDEX(Line,'Carriagecontrol=')
  150.       p3 = INDEX(Line,'carriagecontrol=')
  151.       p = MAX(p1,p2,p3)
  152.       IF (p .GT. 0) THEN
  153.           p1 = INDEX(Line(p+17:),'''') + 17
  154.           q = p + p1
  155.           Acomma = .FALSE.
  156.           DO WHILE (p .GT. 0 .AND. .NOT. Acomma)
  157.               IF (Line(p:p) .EQ. ',') Acomma = .TRUE.
  158.               p = p - 1
  159.           ENDDO
  160.           IF (p .GT. 0) THEN
  161.               Temp = Line(:p) // Line(q:)
  162.               Line = Temp
  163.           ENDIF
  164.           GOTO 120
  165.       ENDIF
  166. c
  167. c Change VAX-style "$" formatting code to MS-equivalent "\".
  168. c
  169.       q = Len_Trim(Line)
  170.       p1 = INDEX(Line,'FORMAT')
  171.       p2 = INDEX(Line,'Format')
  172.       p3 = INDEX(Line,'format')
  173.       p = MAX(p1,p2,p3)
  174.       IF (p .GT. 0) THEN
  175.           IF (Line(q-2:q-1) .EQ. ',$') THEN
  176.               Line(q-1:q-1) = '\'
  177.               GOTO 120
  178.           ENDIF
  179.       ENDIF
  180. c----------------------------------------------------------------------------
  181. c Here is where the line is output and reformatted to 72 characters.
  182. c If the first character is a tab, then it's either a beginning line
  183. c or a continuation line. If the character after the tab is a digit 1-9
  184. c then it's a continuation line. Begin building the output line.
  185. c p is the position in Line and q in Out.
  186. c
  187. 120   Out = ' '
  188.       IF (Line(1:1) .EQ. TAB_CHAR) THEN
  189.           IF (IsDigit(Line(2:2))) THEN
  190.               Out(6:6) = Line(2:2)
  191.               p = 3
  192.           ELSE
  193.               p = 2
  194.           ENDIF
  195.           q = 7
  196.       ELSEIF (IsDigit(Line(1:1))) THEN
  197.           p = 1
  198.           q = 1
  199.           StillDigit = IsDigit(Line(p:p))
  200.           DO WHILE (StillDigit)
  201.               Out(q:q) = Line(p:p)
  202.               q = q + 1
  203.               p = p + 1
  204.               StillDigit = IsDigit(Line(p:p))
  205.           ENDDO
  206.           p = p + 1
  207.           q = 7
  208.       ELSE
  209.           Out = Line
  210.           GOTO 150
  211.       ENDIF
  212. c
  213. c For remainder of line, test for length exceeding 72 and start a new
  214. c continuation line if necessary. Don't continue if the excess is an
  215. c inline comment (!...) but check for being quoted first. Tabs not in
  216. c quotes are replaced with TAB_SIZE blanks.
  217. c
  218.       InQuote = .FALSE.
  219.       InComment = .FALSE.
  220. 125   DO WHILE (q .LE. 72 .AND. p .LE. Len_Trim(Line))
  221.  
  222.           IF (Line(p:p) .EQ. TAB_CHAR .AND. .NOT. InQuote) THEN
  223.               q = q + TAB_SIZE
  224.               p = p + 1
  225.               CYCLE
  226.           ELSE
  227.                 Out(q:q) = Line(p:p)
  228.           ENDIF
  229.  
  230.           IF (Line(p:p) .EQ. '''') THEN
  231.               InQuote = .NOT. InQuote
  232.           ELSEIF (Line(p:p) .EQ. '!' .AND. .NOT. InQuote) THEN
  233.               InComment = .TRUE.
  234.           ENDIF
  235.  
  236.           p = p + 1
  237.           q = q + 1
  238.  
  239.       ENDDO
  240.       IF (InComment) Out(q:) = Line(p+1:)
  241.  
  242.       IF (p .LE. Len_Trim(Line) .AND. .NOT. InComment) THEN
  243.           WRITE (2,2) Out(:Len_Trim(Out))
  244.           Out = '     +'
  245.           q = 7
  246.           GOTO 125
  247.       ENDIF
  248.  
  249. 150   IF (Len_Trim(Out) .GT. 0) THEN
  250.           WRITE (2,2) Out(:Len_Trim(Out))
  251.       ELSE
  252.           WRITE (2,2) ' '
  253.       ENDIF
  254.       GOTO 100
  255. 199   STOP
  256.       END
  257. c----------------------------------------------------------------------------
  258. c
  259. c This function is used because the MS Powerstation VERIFY function
  260. c doesn't work as advertised.
  261. c
  262.       LOGICAL FUNCTION IsDigit(C)
  263.       CHARACTER C*1
  264.  
  265.       IF (C .LT. '0' .OR. C .GT. '9') THEN
  266.           IsDigit = .FALSE.
  267.       ELSE
  268.           IsDigit = .TRUE.
  269.       ENDIF
  270.  
  271.       RETURN
  272.       END
  273. c----------------------------------------------------------------------------
  274.